(defpackage :ortho
  (:use :cl)
  (:export #:add-ortho-type
	   #:ortho-type
	   #:base->type
	   #:type->base))

(in-package :ortho)

(defvar *ortho-types-table* (make-hash-table))

(defun ortho-type (type)
  (multiple-value-bind (type found-p)
      (gethash type *ortho-types-table*)
    (unless found-p
      (error "Ortho type ~S not found" type))
    type))

(defun (setf ortho-type) (value type)
  (setf (gethash type *ortho-types-table*)
	value))

(defun add-ortho-type (typename base->type type->base)
  (setf (ortho-type typename)
	(cons base->type type->base)))

(defun base->type (type x)
  "Convert `x' in the base type for its type class to `type'"
  (let ((converter (car (ortho-type type))))
    (funcall converter x)))

(defun type->base (type x)
  "Convert `x' of type `type' to the base type of its type class"
  (let ((converter (cdr (ortho-type type))))
    (funcall converter x)))